SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00001 1 08-24-9413:19ALL ERIK ANDERSON ANSI File Dump SWAG9408 ╚X ▌ 36 .g {πML>p.p.s I also need a routine (preferably in Turbo Pascal 7 ASM) that saves tπML> content of the current screen in an ANSI file on the disk. I saw oneπML> a while ago in SWAG, but I can't seem to find it now (I'm a dist siteπML> but still can't find it).ππAlso, since I didn't have anything better to do, I sat down and did aπversion of your screen->ANSI. It's rather primitive... it does a 80x24πdump with auto-EOLn seensing, does no CRLF if the line is 80 chars longπ(relies on screen wrap) and no macroing. If you want to, you can addπmacroing, which replaces a number of spaces with a single ANSI 'setπcursor' command. Well, here goes...ππ=================================================================== }ππ Procedure Xlate(var OutFile : text); {by Erik Anderson}π {The screen is basically an array of elements, each element containing oneπ a one-byte character and a one-byte color attribute}π constπ NUMROWS = 25;π NUMCOLS = 80;π typeπ ElementType = recordπ ch : char;π Attr : byte;π end;π ScreenType = array[1..NUMROWS,1..NUMCOLS] of ElementType;ππ {The Attribute is structured as follows:π bit 0: foreground blue elementπ bit 1: " green elementπ bit 2: " red elementπ bit 3: high intensity flagπ bit 4: background blue elementπ bit 5: " green elementπ bit 6: " red elementπ bit 7: flash flagππ The following constant masks help the program acess different partsπ of the attribute}π constπ TextMask = $07; {0000 0111}π BoldMask = $08; {0000 1000}π BackMask = $70; {0111 0000}π FlshMask = $80; {1000 0000}π BackShft = 4;ππ ESC = #$1B;ππ {ANSI colors are not the same as IBM colors... this table fixes theπ discrepancy:}π ANSIcolors : array[0..7] of byte = (0, 4, 2, 6, 1, 5, 3, 7);ππ {This procedure sends the new attribute to the ANSI dump file}π Procedure ChangeAttr(var Outfile : text; var OldAtr : byte; NewAtr : byte);π varπ Connect : string[1]; {Is a seperator needed?}π beginπ Connect := '';π write(Outfile, ESC, '['); {Begin sequence}π If (OldAtr AND (BoldMask+FlshMask)) <> {Output flash & blink}π (NewAtr AND (BoldMask+FlshMask)) then beginπ write(Outfile, '0');π If NewAtr AND BoldMask <> 0 then write(Outfile, ';1');π If NewAtr AND FlshMask <> 0 then write(Outfile, ';5');π OldAtr := $FF; Connect := ';'; {Force other attr's to print}π end;ππ If OldAtr AND BackMask <> NewAtr AND BackMask then beginπ write(OutFile, Connect,π ANSIcolors[(NewAtr AND BackMask) shr BackShft] + 40);π Connect := ';';π end;ππ If OldAtr AND TextMask <> NewAtr AND TextMask then beginπ write(OutFile, Connect,π ANSIcolors[NewAtr AND TextMask] + 30);π end;ππ write(outfile, 'm'); {Terminate sequence}π OldAtr := NewAtr;π end;ππ {Does this character need a changing of the attribute? If it is a space,π then only the background color matters}ππ Function AttrChanged(Attr : byte; ThisEl : ElementType) : boolean;π varπ Result : boolean;π beginπ Result := FALSE;π If ThisEl.ch = ' ' then beginπ If ThisEl.Attr AND BackMask <> Attr AND BackMask thenπ Result := TRUE;π end else beginπ If ThisEl.Attr <> Attr then Result := TRUE;π end;π AttrChanged := Result;π end;ππ varπ Screen : ScreenType absolute $b800:0000;π ThisAttr, TestAttr : byte;π LoopRow, LoopCol, LineLen : integer;π begin {Xlate}π ThisAttr := $FF; {Force attribute to be set}π For LoopRow := 1 to NUMROWS do beginππ LineLen := NUMCOLS; {Find length of line}π While (LineLen > 0) and (Screen[LoopRow, LineLen].ch = ' ')π and not AttrChanged($00, Screen[LoopRow, LineLen])π do Dec(LineLen);ππ For LoopCol := 1 to LineLen do begin {Send stream to file}π If AttrChanged(ThisAttr, Screen[LoopRow, LoopCol])π then ChangeAttr(Outfile, ThisAttr, Screen[LoopRow, LoopCol].Attr);π write(Outfile, Screen[LoopRow, LoopCol].ch);π end;π If LineLen < 80 then writeln(OutFile); {else wraparound occurs}π end;π end; {Xlate}ππvarπ OutFile : text;πbeginπ Assign(OutFile, 'dump.scn');π Rewrite(OutFile);π Xlate(OUtFile);π Close(OUtFile);πend.ππ
